home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / os2 / lxlt113.zip / SOURCES / COMMON / MISCUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-06  |  27KB  |  906 lines
  1. {$A-,B-,D+,E-,F-,G-,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
  2. {$ifDef VirtualPascal}
  3. {$AlignCode-,AlignData-,AlignRec-,G3+,Speed-,Frame-}
  4. {$endif}
  5. Unit miscUtil;
  6.  
  7. Interface uses use32;
  8.  
  9. const _ON             = true;
  10.       _OFF            = false;
  11.  
  12.       ioOK            = 0;
  13.       ioNoSuchFile    = 1;
  14.       ioNoMemory      = 2;
  15.       ioReadError     = 3;
  16.       ioWriteError    = 4;
  17.       ioCantCreate    = 5;
  18.       ioBadFormat     = 6;
  19.  
  20. type  tArrOfByte      = array[0..65500] of Byte;
  21.       pArrOfByte      = ^tArrOfByte;
  22.       tArrOfWord      = array[0..32700] of Word;
  23.       pArrOfWord      = ^tArrOfWord;
  24.       tArrOfSmallWord = array[0..32700] of SmallWord;
  25.       pArrOfSmallWord = ^tArrOfSmallWord;
  26.       tArrOfLong      = array[0..16380] of Longint;
  27.       pArrOfLong      = ^tArrOfLong;
  28.       tArrOfPtr       = array[0..16380] of Pointer;
  29.       pArrOfPtr       = ^tArrOfPtr;
  30.       tArrOfChar      = array[0..65500] of Char;
  31.       pArrOfChar      = ^tArrOfChar;
  32.       pByte           = ^Byte;
  33.       pWord           = ^Word;
  34.       pSmallWord      = ^SmallWord;
  35.       pInteger        = ^Integer;
  36.       pLong           = ^Longint;
  37.       pString         = ^String;
  38.     { Compare function for QuickSort. Return TRUE if Buff[N1] is 'greater    }
  39.     { or _EQUAL_' than Buff[N2]. If it will return simply 'less' or 'greater'}
  40.     { the function will cause a protection failure in the best case. If you  }
  41.     { use the QuickSort with CmpFunc, you don`t need to specify element size }
  42.       tCmpFunc        = Function(var Buff; N1,N2 : Word) : boolean;
  43.     { Procedure which exchanges element N1 with N2 in Buff for QuickSort     }
  44.     { Note that N1 and N2 in both cases are zero-based                       }
  45.       tXchgProc       = Procedure(var Buff; N1,N2 : Word);
  46.     { Dynamic array object }
  47.       tArOfPtr        = array[1..1000] of Pointer;
  48.       pArOfPtr        = ^tArOfPtr;
  49.       pDArray         = ^TDArray;
  50.       tDArray         = object
  51.        NumItems,
  52.        MaxItem     : Longint;
  53.        Root        : pArOfPtr;
  54.       {Initialize dynamic array; reserve space for StartVal elements}
  55.        Constructor Init(StartVal : Longint);
  56.       {Add a variable (or reference to variable) into array}
  57.        Procedure   AddItem(V : Pointer);
  58.       {Delete a variable from array}
  59.        Procedure   DelItem(No : Longint);
  60.       {Return variable number No}
  61.        Function    GetItem(No : Longint) : Pointer;
  62.       {Replace variable number No by V and return old pointer value}
  63.        Function    RplItem(No : Longint; V : Pointer) : Pointer;
  64.       {Exchange items N1 & N2}
  65.        Procedure   XchgItems(N1,N2 : Longint);
  66.       {Clear array}
  67.        Procedure   Clear;
  68.       {Destroy array object}
  69.        Destructor  Done;
  70.       end;
  71.  
  72. { Dynamic string [de]allocation routines }
  73.  Function  NewStr(const S : String) : pString;
  74.  Procedure DisposeStr(P : PString);
  75.  
  76. { Quick sort routine. Element size must be one of 1,2,4 if cmpFunc is }
  77. { not provided (is nil) - the array will be sorted in usual way (i.e. }
  78. { from minimal to maximal value. If you use cmpFunc it`s also in your }
  79. { responsability to supply a valid xchgProc pointer.                  }
  80. { NOTE THAT BYTES, WORDS AND DWORDS WILL BE TREATED AS UNSIGNED VALUE }
  81. {$ifDef use32}
  82.  Procedure QuickSort(var Buff; First,Last : Word; ElementSize : Byte;
  83.                      cmpFunc : tCmpFunc; xchgProc : tXchgProc);
  84. {$endIf}
  85.  
  86. { Bit-manipulation routines }
  87.  Function  bitTest(var bitArray; BitNo : Word) : boolean;
  88.  Procedure bitSet(var bitArray; BitNo : Word);
  89.  Procedure bitReset(var bitArray; BitNo : Word);
  90.  
  91. {Bit scan forward/reverse functions; return 255 if no set bits in A}
  92.  Function  BitSF(A : Longint) : Byte;
  93.  Function  BitSR(A : Longint) : Byte;
  94.  
  95. { Min/max functions }
  96.  Function  minL(A,B : Longint) : Longint;
  97.  Function  maxL(A,B : Longint) : Longint;
  98.  
  99. { The same as System.Move but address always increments (i.e. CLD)  }
  100. { and uses bytes (does not optimize transfer by dwords/words/bytes) }
  101. { Use it ONLY when there is no possibility of overlapping A & B     }
  102.  Procedure linearMove(var A,B; Size : Word);
  103.  
  104. { Compare two strings; return 0 if equal; positive if A>B and negative if A<B }
  105.  Function  MemCmp(var A,B; Size : Word) : Shortint;
  106.  
  107. { Exchange bytes, words, double words and vars of any size }
  108.  Procedure XchgB(var A,B);
  109.  Procedure XchgW(var A,B);
  110.  Procedure XchgL(var A,B);
  111.  Procedure Xchg(var A,B; Size : Word);
  112.  
  113. { Search buffer Buff of length BuffLen for a Target of given length TargetLen }
  114.  Function  Search(var Buff; BuffLen : Word; var Target; TargetLen : Word) : Word;
  115.  
  116. { Return interval in minutes between two events }
  117.  Function  TimeInterval(sYear,sMonth,sDay,sHour,sMin,
  118.                         fYear,fMonth,fDay,fHour,fMin : Word) : Longint;
  119. {$ifDef use32}
  120.  Function bTicker : Byte;
  121.  Function wTicker : Word;
  122.  Function lTicker : Longint;
  123. {$else use32}
  124.  Function bTicker : Byte;
  125.  InLine( $8E/$06/seg0040/   { mov   es,seg0040   }
  126.          $26/$A0/$6C/$00);  { mov   ax,es:[6Ch] }
  127.  Function wTicker : Word;
  128.  InLine( $8E/$06/seg0040/   { mov   es,seg0040   }
  129.          $26/$A1/$6C/$00);  { mov   ax,es:[6Ch] }
  130.  Function lTicker : Longint;
  131.  InLine( $8E/$06/seg0040/   { mov   es,seg0040   }
  132.          $26/$A1/$6C/$00/   { mov   ax,es:[6Ch] }
  133.          $26/$8B/$16/$6E/$00);{mov  dx,es:[6Eh] }
  134. {$endIf use32}
  135.  
  136. Implementation
  137. {$ifDef os2}
  138.  uses os2base;
  139. {$endIf}
  140.  
  141. constructor tDarray.Init;
  142. begin
  143.  GetMem(Root, StartVal * 4);
  144.  NumItems := 0;
  145.  MaxItem := StartVal;
  146. end;
  147.  
  148. procedure tDarray.AddItem;
  149. var p : Pointer;
  150. begin
  151.  Inc(numItems);
  152.  if numItems > maxItem
  153.     then begin
  154.           Inc(maxItem, 16); GetMem(p, maxItem * sizeOf(Pointer));
  155.           Move(Root^, p^, pred(numItems) * sizeOf(Pointer));
  156.           FreeMem(Root,(maxItem - 16) * sizeOf(Pointer)); Root := p;
  157.          end;
  158.  Root^[numItems] := V;
  159. end;
  160.  
  161. procedure tDarray.DelItem;
  162. var p : Pointer;
  163. begin
  164.  if (No > NumItems) or (NumItems = 0) then Exit;
  165.  Move(Root^[No + 1], Root^[No], (NumItems-No) * sizeOf(Pointer));
  166.  Dec(NumItems);
  167.  if NumItems < MaxItem - 16
  168.     then begin
  169.           Dec(MaxItem, 16); GetMem(p, MaxItem * sizeOf(Pointer));
  170.           Move(Root^, p^, NumItems * sizeOf(Pointer));
  171.           FreeMem(Root, (MaxItem + 16) * sizeOf(Pointer)); Root := p;
  172.          end;
  173. end;
  174.  
  175. function tDarray.GetItem;
  176. begin
  177.  if (No > 0) and (No <= NumItems)
  178.     then GetItem := Root^[No]
  179.     else GetItem := NIL;
  180. end;
  181.  
  182. Function tDarray.RplItem;
  183. begin
  184.  XchgL(Root^[No], V); RplItem := V;
  185. end;
  186.  
  187. Procedure tDarray.XchgItems(N1,N2 : Longint);
  188. begin
  189.  if (N1 > 0) and (N2 > 0) and (N1 <= NumItems) and (N2 <= NumItems)
  190.   then XchgL(Root^[N1], Root^[N2]);
  191. end;
  192.  
  193. Procedure tDarray.Clear;
  194. begin
  195.  if NumItems <> 0
  196.   then begin
  197.         FreeMem(Root, MaxItem * sizeOf(Pointer));
  198.         GetMem(Root, 16 * sizeOf(Pointer)); NumItems := 0; MaxItem := 16;
  199.        end;
  200. end;
  201.  
  202. destructor tDarray.Done;
  203. begin
  204.  FreeMem(Root, MaxItem * sizeOf(Pointer));
  205. end;
  206.  
  207. Function NewStr;
  208. var P : PString;
  209. begin
  210.  if S = ''
  211.   then P := nil
  212.   else begin
  213.         GetMem(P, succ(length(S)));
  214.         if P <> nil then P^ := S;
  215.        end;
  216.  NewStr := P;
  217. end;
  218.  
  219. Procedure DisposeStr;
  220. begin
  221.  if P <> NIL then FreeMem(p, succ(length(p^)));
  222. end;
  223.  
  224. {$ifDef VirtualPascal ██████ Implementation specific for Virtual Pascal █████}
  225. {$frame+,uses ebx,edi,esi}
  226. Procedure QuickSort; assembler;
  227. asm             mov     eax,First
  228.                 cmp     eax,Last
  229.                 jge     @@done
  230.                 push    eax
  231.                 push    Last
  232.                 push    offset @@done
  233.                 cmp     cmpFunc,0
  234.                 jne     @@qsAny
  235.                 mov     al,ElementSize
  236.                 cmp     al,1
  237.                 je      @@qsByte
  238.                 cmp     al,2
  239.                 je      @@qsWord
  240.                 cmp     al,4
  241.                 je      @@qsDWord               {For maximal speed}
  242.                 jmp     @@done3d
  243.  
  244. {*** Sort Buff as bytes ***}
  245. @@qsByte:       mov     esi,Buff
  246.                 mov     edi,esi
  247.                 mov     eax,[esp+8]             {First}
  248.                 mov     ecx,eax
  249.                 add     esi,eax
  250.                 mov     eax,[esp+4]             {Last}
  251.                 add     ecx,eax
  252.                 shr     ecx,1
  253.                 mov     bl,[edi+ecx]            {BL = Buff[(first+last)/2]}
  254.                 add     edi,eax
  255. @@repeat1b:     dec     esi
  256. @@loop1b:       inc     esi
  257.                 cmp     bl,[esi]
  258.                 ja      @@loop1b
  259.  
  260.                 inc     edi
  261. @@loop2b:       dec     edi
  262.                 cmp     bl,[edi]
  263.                 jb      @@loop2b
  264.  
  265.                 cmp     esi,edi
  266.                 ja      @@done2b
  267.                 je      @@done1b
  268.                 mov     al,[esi]
  269.                 xchg    al,[edi]
  270.                 mov     [esi],al
  271.                 inc     esi
  272.                 dec     edi
  273.                 jmp     @@repeat1b
  274. @@done1b:       inc     esi
  275.                 dec     edi
  276. @@done2b:       mov     eax,[esp+8]
  277.                 sub     edi,Buff
  278.                 jc      @@skip1b
  279.                 cmp     eax,edi
  280.                 jae     @@skip1b
  281.                 push    esi
  282.                 push    eax
  283.                 push    edi
  284.                 call    @@qsByte
  285.                 pop     esi
  286. @@skip1b:       sub     esi,Buff
  287.                 jc      @@skip2b
  288.                 mov     eax,[esp+4]
  289.                 cmp     esi,eax
  290.                 jae     @@skip2b
  291.                 push    esi
  292.                 push    eax
  293.                 call    @@qsByte
  294. @@skip2b:       ret     8
  295.  
  296. {*** Sort Buff as words ***}
  297. @@qsWord:       mov     esi,Buff
  298.                 mov     edi,esi
  299.                 mov     eax,[esp+8]             {First}
  300.                 mov     ecx,eax
  301.                 shl     eax,1
  302.                 add     esi,eax
  303.                 mov     eax,[esp+4]             {Last}
  304.                 add     ecx,eax
  305.                 shr     ecx,1
  306.                 mov     bx,[edi+ecx*2]          {BX = Buff[(first+last)/2]}
  307.                 shl     eax,1
  308.                 add     edi,eax
  309. @@repeat1w:     sub     esi,2
  310. @@loop1w:       add     esi,2
  311.                 cmp     bx,[esi]
  312.                 ja      @@loop1w
  313.  
  314.                 add     edi,2
  315. @@loop2w:       sub     edi,2
  316.                 cmp     bx,[edi]
  317.                 jb      @@loop2w
  318.  
  319.                 cmp     esi,edi
  320.                 ja      @@done2w
  321.                 je      @@done1w
  322.                 mov     ax,[esi]
  323.                 xchg    ax,[edi]
  324.                 mov     [esi],ax
  325.                 add     esi,2
  326.                 sub     edi,2
  327.                 jmp     @@repeat1w
  328. @@done1w:       add     esi,2
  329.                 sub     edi,2
  330. @@done2w:       mov     eax,[esp+8]
  331.                 sub     edi,Buff
  332.                 jc      @@skip1w
  333.                 shr     edi,1
  334.                 cmp     eax,edi
  335.                 jae     @@skip1w
  336.                 push    esi
  337.                 push    eax
  338.                 push    edi
  339.                 call    @@qsWord
  340.                 pop     esi
  341. @@skip1w:       sub     esi,Buff
  342.                 jc      @@skip2w
  343.                 shr     esi,1
  344.                 mov     eax,[esp+4]
  345.                 cmp     esi,eax
  346.                 jae     @@skip2w
  347.                 push    esi
  348.                 push    eax
  349.                 call    @@qsWord
  350. @@skip2w:       ret     8
  351.  
  352. {*** Sort Buff as dwords ***}
  353. @@qsDWord:      mov     esi,Buff
  354.                 mov     edi,esi
  355.                 mov     eax,[esp+8]             {First}
  356.                 mov     ecx,eax
  357.                 shl     eax,2
  358.                 add     esi,eax
  359.                 mov     eax,[esp+4]             {Last}
  360.                 add     ecx,eax
  361.                 shr     ecx,1
  362.                 mov     ebx,[edi+ecx*4]         {EBX = Buff[(first+last)/2]}
  363.                 shl     eax,2
  364.                 add     edi,eax
  365. @@repeat1d:     sub     esi,4
  366. @@loop1d:       add     esi,4
  367.                 cmp     ebx,[esi]
  368.                 ja      @@loop1d
  369.  
  370.                 add     edi,4
  371. @@loop2d:       sub     edi,4
  372.                 cmp     ebx,[edi]
  373.                 jb      @@loop2d
  374.  
  375.                 cmp     esi,edi
  376.                 ja      @@done2d
  377.                 je      @@done1d
  378.                 mov     eax,[esi]
  379.                 xchg    eax,[edi]
  380.                 mov     [esi],eax
  381.                 add     esi,4
  382.                 sub     edi,4
  383.                 jmp     @@repeat1d
  384. @@done1d:       add     esi,4
  385.                 sub     edi,4
  386. @@done2d:       mov     eax,[esp+8]
  387.                 sub     edi,Buff
  388.                 jc      @@skip1d
  389.                 shr     edi,2
  390.                 cmp     eax,edi
  391.                 jae     @@skip1d
  392.                 push    esi
  393.                 push    eax
  394.                 push    edi
  395.                 call    @@qsDWord
  396.                 pop     esi
  397. @@skip1d:       sub     esi,Buff
  398.                 jc      @@skip2d
  399.                 shr     esi,2
  400.                 mov     eax,[esp+4]
  401.                 cmp     esi,eax
  402.                 jae     @@skip2d
  403.                 push    esi
  404.                 push    eax
  405.                 call    @@qsDWord
  406. @@skip2d:       ret     8
  407.  
  408. {*** Sort Buff as any values ***}
  409. @@qsAny:        cmp     xchgProc,0
  410.                 je      @@done3d
  411.                 mov     esi,[esp+8]             {First}
  412.                 mov     ebx,esi
  413.                 mov     edi,[esp+4]             {Last}
  414.                 add     ebx,edi
  415.                 shr     ebx,1                   {EBX = (first+last)/2}
  416. @@repeat1a:     dec     esi
  417. @@loop1a:       inc     esi
  418.                 push    Buff
  419.                 push    esi
  420.                 push    ebx
  421.                 call    cmpFunc                 {Assume $SAVES ebx,esi,edi}
  422.                 test    al,al
  423.                 je      @@loop1a
  424.  
  425.                 inc     edi
  426. @@loop2a:       dec     edi
  427.                 push    Buff
  428.                 push    ebx
  429.                 push    edi
  430.                 call    cmpFunc                 {Assume $SAVES esi,edi}
  431.                 test    al,al
  432.                 je      @@loop2a
  433.  
  434.                 cmp     esi,edi
  435.                 ja      @@done2a
  436.                 je      @@done1a
  437.                 push    Buff
  438.                 push    esi
  439.                 push    edi
  440.                 call    xchgProc
  441.                 cmp     ebx,esi
  442.                 jne     @@xchg1a
  443.                 mov     ebx,edi
  444.                 jmp     @@xchg2a
  445. @@xchg1a:       cmp     ebx,edi
  446.                 jne     @@xchg2a
  447.                 mov     ebx,esi
  448. @@xchg2a:       inc     esi
  449.                 dec     edi
  450.                 jmp     @@repeat1a
  451. @@done1a:       inc     esi
  452.                 dec     edi
  453. @@done2a:       mov     eax,[esp+8]
  454.                 test    edi,edi
  455.                 js      @@skip1a
  456.                 cmp     eax,edi
  457.                 jae     @@skip1a
  458.                 push    esi
  459.                 push    eax
  460.                 push    edi
  461.                 call    @@qsAny
  462.                 pop     esi
  463. @@skip1a:       test    esi,esi
  464.                 js      @@skip2a
  465.                 mov     eax,[esp+4]
  466.                 cmp     esi,eax
  467.                 jae     @@skip2a
  468.                 push    esi
  469.                 push    eax
  470.                 call    @@qsAny
  471. @@skip2a:       ret     8
  472.  
  473. @@done3d:       add     esp,4+4+4
  474. @@done:
  475. end;
  476. {$frame-,uses none}
  477.  
  478. {$saves ebx,edx,esi,edi}
  479. Function bitTest; assembler;
  480. asm             mov     eax,bitArray
  481.                 mov     ecx,bitNo
  482.                 bt      [eax],ecx
  483.                 setc    al
  484. end;
  485.  
  486. Procedure bitSet; assembler;
  487. asm             mov     eax,bitArray
  488.                 mov     ecx,bitNo
  489.                 bts     [eax],ecx
  490. end;
  491.  
  492. Procedure bitReset; assembler;
  493. asm             mov     eax,bitArray
  494.                 mov     ecx,bitNo
  495.                 btr     [eax],ecx
  496. end;
  497.  
  498. {$saves ebx,esi,edi}
  499. Procedure XchgB(var a,b); assembler;
  500. asm             mov     ecx,A
  501.                 mov     edx,B
  502.                 mov     al,[ecx]
  503.                 xchg    al,[edx]
  504.                 mov     [ecx],al
  505. end;
  506.  
  507. Procedure XchgW(var a,b); assembler;
  508. asm             mov     ecx,A
  509.                 mov     edx,B
  510.                 mov     ax,[ecx]
  511.                 xchg    ax,[edx]
  512.                 mov     [ecx],ax
  513. end;
  514.  
  515. Procedure XchgL; assembler;
  516. asm             mov     ecx,A
  517.                 mov     edx,B
  518.                 mov     eax,[ecx]
  519.                 xchg    eax,[edx]
  520.                 mov     [ecx],eax
  521. end;
  522.  
  523. {$uses ebx}
  524. Procedure Xchg(var A,B; Size : Word); assembler;
  525. asm             mov     ebx,A
  526.                 mov     edx,B
  527.                 mov     ecx,Size
  528. @@next:         mov     al,[ebx]
  529.                 xchg    al,[edx]
  530.                 mov     [ebx],al
  531.                 inc     ebx
  532.                 inc     edx
  533.                 loop    @@next
  534. end;
  535. {$uses none}
  536.  
  537. {$uses esi,edi} {$saves eax,ebx,edx}
  538. Procedure linearMove; assembler;
  539. asm             cld
  540.                 mov     esi,A
  541.                 mov     edi,B
  542.                 mov     ecx,Size
  543.                 rep     movsb
  544. end;
  545. {$uses none}
  546.  
  547. {$saves all}
  548. Function minL; assembler;
  549. asm             mov     eax,A
  550.                 cmp     eax,B
  551.                 jl      @@ok
  552.                 mov     eax,B
  553. @@ok:
  554. end;
  555.  
  556. Function maxL; assembler;
  557. asm             mov     eax,A
  558.                 cmp     eax,B
  559.                 jg      @@ok
  560.                 mov     eax,B
  561. @@ok:
  562. end;
  563.  
  564. Function BitSF; assembler;
  565. asm             mov     eax,A
  566.                 bsf     eax,eax
  567.                 jnz     @@ok
  568.                 dec     al
  569. @@ok:
  570. end;
  571.  
  572. Function BitSR; assembler;
  573. asm             mov     eax,A
  574.                 bsr     eax,eax
  575.                 jnz     @@ok
  576.                 dec     al
  577. @@ok:
  578. end;
  579.  
  580. {$uses esi,edi} {$saves ebx,edx,esi,edi}
  581. Function MemCmp; assembler;
  582. asm             cld
  583.                 mov    esi,A
  584.                 mov    edi,B
  585.                 mov    ecx,Size
  586.                 repe   cmpsb
  587.                 lahf
  588.                 mov    al,ah
  589.                 and    al,0C0h         {Dirty trick :)}
  590.                 xor    al,040h
  591. end;
  592. {$uses none}
  593.  
  594. Function Search; assembler;
  595. asm             cld
  596.                 mov     edi,Buff
  597.                 mov     ecx,BuffLen
  598.                 sub     ecx,TargetLen
  599.                 jbe     @@notFound
  600.                 inc     ecx
  601.                 mov     esi,Target
  602.                 mov     al,[esi]
  603. @@Scan:         repne   scasb
  604.                 jne     @@notFound
  605.                 push    ecx
  606.                 push    esi
  607.                 push    edi
  608.                 dec     edi
  609.                 mov     ecx,TargetLen
  610.                 repe    cmpsb
  611.                 pop     edi
  612.                 pop     esi
  613.                 pop     ecx
  614.                 jne     @@Scan
  615.                 dec     edi
  616.                 sub     edi,Buff
  617.                 mov     eax,edi
  618.                 jmp     @@locEx
  619. @@notFound:     mov     eax,-1
  620. @@locEx:
  621. end;
  622.  
  623. {$else ███████████ Implementation specific for Borland Pascal 7.0 ███████████}
  624.  
  625. Procedure bitSet; assembler;
  626. asm             les     di,bitArray
  627.                 mov     bx,bitNo
  628.                 cmp     test8086,2
  629.                 jb      @@8086
  630.                 db      $26,$0F,$AB,$1D {bts es:[di],bx}
  631.                 jmp     @@locEx
  632.  
  633. @@8086:         mov     cl,bl
  634.                 shr     bx,1
  635.                 shr     bx,1
  636.                 shr     bx,1
  637.                 and     cl,7
  638.                 mov     al,00000001b
  639.                 rol     al,cl
  640.                 or      es:[bx+di],al
  641. @@locEx:
  642. end;
  643.  
  644. Procedure bitReset; assembler;
  645. asm             les     di,bitArray
  646.                 mov     bx,bitNo
  647.                 cmp     test8086,2
  648.                 jb      @@8086
  649.                 db      $26,$0F,$B3,$1D {btr es:[di],bx}
  650.                 jmp     @@locEx
  651.  
  652. @@8086:         mov     cl,bl
  653.                 shr     bx,1
  654.                 shr     bx,1
  655.                 shr     bx,1
  656.                 and     cl,7
  657.                 mov     al,11111110b
  658.                 rol     al,cl
  659.                 and     es:[bx+di],al
  660. @@locEx:
  661. end;
  662.  
  663. Function bitTest; assembler;
  664. asm             les     di,bitArray
  665.                 mov     bx,bitNo
  666.                 cmp     test8086,2
  667.                 jb      @@8086
  668.                 db      $26,$0F,$A3,$1D {bt es:[di],bx}
  669.                 db      $0F,$92,$C0     {setc al}
  670.                 jmp     @@locEx
  671.  
  672. @@8086:         mov     cl,bl
  673.                 shr     bx,1
  674.                 shr     bx,1
  675.                 shr     bx,1
  676.                 and     cl,7
  677.                 mov     al,00000001b
  678.                 rol     al,cl
  679.                 test    es:[bx+di],al
  680.                 mov     al,0
  681.                 jz      @@locEx
  682.                 inc     al
  683. @@locEx:
  684. end;
  685.  
  686. Function bitSF; assembler;
  687. asm      db $66;mov     ax,A.word
  688.          db $66,$0F,$BC,$C0 {bsf eax,eax}
  689.                 jnz     @@ok
  690.                 dec     al
  691. @@ok:
  692. end;
  693.  
  694. Function bitSR; assembler;
  695. asm      db $66;mov     ax,A.word
  696.          db $66,$0F,$BD,$C0 {bsr eax,eax}
  697.                 jnz     @@ok
  698.                 dec     al
  699. @@ok:
  700. end;
  701.  
  702. Function MemCmp; assembler;
  703. asm             cld
  704.                 push    ds
  705.                 lds     si,A
  706.                 les     di,B
  707.                 mov     cx,Size
  708.                 repe    cmpsb
  709.                 pop     ds
  710.                 lahf
  711.                 mov     al,ah
  712.                 and     al,0C0h {Dirty trick :)}
  713.                 xor     al,040h
  714. end;
  715.  
  716. Function Search; assembler;
  717. asm             cld
  718.                 push    ds
  719.                 les     di,Buff
  720.                 mov     cx,BuffLen
  721.                 sub     cx,TargetLen
  722.                 jbe     @@NotFound
  723.                 inc     cx
  724.                 lds     si,Target
  725.                 mov     al,[si]
  726. @@Scan:         repne   scasb
  727.                 jne     @@NotFound
  728.                 push    cx
  729.                 push    si
  730.                 push    di
  731.                 dec     di
  732.                 mov     cx,TargetLen
  733.                 repe    cmpsb
  734.                 pop     di
  735.                 pop     si
  736.                 pop     cx
  737.                 jne     @@Scan
  738.                 dec     di
  739.                 sub     di,Buff.word
  740.                 mov     ax,di
  741.                 jmp     @@locEx
  742. @@NotFound:     mov     ax,-1
  743. @@locEx:        pop     ds
  744. end;
  745.  
  746. Procedure XchgB(var a,b); assembler;
  747. asm             push    ds
  748.                 les     di,a
  749.                 lds     si,b
  750.                 mov     al,es:[di]
  751.                 xchg    al,ds:[si]
  752.                 cld
  753.                 stosb
  754.                 pop     ds
  755. end;
  756.  
  757. Procedure XchgW(var a,b); assembler;
  758. asm             push    ds
  759.                 les     di,a
  760.                 lds     si,b
  761.                 mov     ax,es:[di]
  762.                 xchg    ax,ds:[si]
  763.                 cld
  764.                 stosw
  765.                 pop     ds
  766. end;
  767.  
  768. Procedure XchgL(var a,b); assembler;
  769. asm             push    ds
  770.                 les     di,a
  771.                 lds     si,b
  772.                 mov     ax,es:[di]
  773.                 xchg    ax,ds:[si]
  774.                 cld
  775.                 stosw
  776.                 mov     ax,es:[di]
  777.                 xchg    ax,ds:[si+2]
  778.                 stosw
  779.                 pop     ds
  780. end;
  781.  
  782. Procedure Xchg(var A,B; Size : Word); assembler;
  783. asm             push    ds
  784.                 lds     si,A
  785.                 les     di,B
  786.                 mov     cx,Size
  787. @@1:            mov     al,ds:[si]
  788.                 xchg    es:[di],al
  789.                 mov     ds:[si],al
  790.                 inc     si
  791.                 inc     di
  792.                 loop    @@1
  793.                 pop     ds
  794. end;
  795.  
  796. Procedure linearMove; assembler;
  797. asm             cld
  798.                 push    ds
  799.                 lds     si,A
  800.                 les     di,B
  801.                 mov     cx,Size
  802.                 rep     movsb
  803.                 pop     ds
  804. end;
  805.  
  806. Function  minL(A,B : Longint) : Longint;
  807. begin
  808.  if A <= B then minL := A else minL := B;
  809. end;
  810.  
  811. Function  maxL(A,B : Longint) : Longint;
  812. begin
  813.  if A >= B then maxL := A else maxL := B;
  814. end;
  815.  
  816. {$endIf ███████████████████ end of compiler - specific  section █████████████}
  817.  
  818. Function TimeInterval(sYear,sMonth,sDay,sHour,sMin,
  819.                       fYear,fMonth,fDay,fHour,fMin : Word) : Longint;
  820. const
  821.     daysInMonth      : array[1..12] of Byte =
  822.     (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  823. var cY,cM,cD,cH,cMin : Word;
  824.     tI               : Longint;
  825.  
  826. procedure IncMonth;
  827. begin
  828.  Inc(cM);
  829.  if cM > 12 then begin cM := 1; Inc(cY); end;
  830. end;
  831.  
  832. procedure IncDay;
  833. begin
  834.  Inc(cD);
  835.  if cD > daysInMonth[cM] + byte((cM = 2) and (cY and 3 = 0))
  836.   then begin cD := 1; IncMonth; end;
  837. end;
  838.  
  839. procedure IncHour;
  840. begin
  841.  Inc(cH);
  842.  if cH > 23 then begin cH := 0; IncDay; end;
  843. end;
  844.  
  845. procedure IncMin;
  846. begin
  847.  Inc(cMin);
  848.  if cMin > 59 then begin cMin := 0; IncHour; end;
  849. end;
  850.  
  851. begin
  852.  cY := sYear; cM := sMonth; cD := sDay;
  853.  cH := sHour; cMin := sMin; tI := 0;
  854.  While (cY <> fYear) or (cM <> fMonth) or (cD <> fDay) or
  855.        (cH <> fHour) or (cMin <> fMin) do
  856.   begin
  857.    if (cY <> fYear) and (cM = 1) and (cD = 1) and (cH = 0) and (cMin = 0)
  858.     then begin
  859.           Inc(tI, longint(365 + byte(cY and 3 = 0)) * 1440);
  860.           Inc(cY);
  861.          end
  862.     else
  863.    if ((cY <> fYear) or (cM <> fMonth)) and (cD = 1) and (cH = 0) and (cMin = 0)
  864.     then begin
  865.           Inc(tI, longint(daysInMonth[cM] + byte((cM = 2) and (cY and 3 = 0))) * 1440);
  866.           IncMonth;
  867.          end
  868.     else
  869.    if ((cY <> fYear) or (cM <> fMonth) or (cD <> fDay)) and (cH = 0) and (cMin = 0)
  870.     then begin
  871.           Inc(tI, 1440); IncDay;
  872.          end
  873.     else
  874.    if ((cY <> fYear) or (cM <> fMonth) or (cD <> fDay) or (cH <> fHour)) and (cMin = 0)
  875.     then begin
  876.           Inc(tI, 60); IncHour;
  877.          end
  878.     else begin
  879.           Inc(tI); IncMin;
  880.          end;
  881.   end;
  882.  TimeInterval := tI;
  883. end;
  884.  
  885. {$ifDef use32}
  886. Function lTicker : Longint;
  887. var L : Longint;
  888. begin
  889.  DosQuerySysInfo(qsv_Ms_Count, qsv_Ms_Count, L, SizeOf(L));
  890.  lTicker := L;
  891. end;
  892.  
  893. Function wTicker : Word;
  894. begin
  895.  wTicker := lTicker and $FFFF;
  896. end;
  897.  
  898. Function bTicker : Byte;
  899. begin
  900.  bTicker := lTicker and $FF;
  901. end;
  902. {$endIf use32}
  903.  
  904. end.
  905.  
  906.